home *** CD-ROM | disk | FTP | other *** search
/ Aminet 31 / Aminet 31 (1999)(Schatztruhe)[!][Jun 1999].iso / Aminet / dev / obero / OberonAModules.lha / SortTools.Mod < prev    next >
Text File  |  1999-02-26  |  3KB  |  217 lines
  1. (*
  2. SortTools.MOD ©1998-99 Morten Bjergstrøm
  3. EMail: mbjergstroem@hotmail.com
  4. *)
  5.  
  6. <*MAIN-*>
  7. MODULE SortTools;
  8.  
  9.  
  10.  
  11. PROCEDURE SwapInt(VAR n1,n2:INTEGER);
  12.  
  13. VAR
  14.   n:INTEGER;
  15.  
  16. BEGIN
  17.  
  18.   n:=n1;
  19.   n1:=n2;
  20.   n2:=n;
  21.   
  22.  
  23. END SwapInt;
  24.  
  25.  
  26. PROCEDURE SwapLong(VAR n1,n2:LONGINT);
  27.  
  28. VAR
  29.   n:LONGINT;
  30.  
  31. BEGIN
  32.  
  33.   n:=n1;
  34.   n1:=n2;
  35.   n2:=n;
  36.   
  37.  
  38. END SwapLong;
  39.  
  40.  
  41. PROCEDURE SelectSortL*(VAR values:ARRAY OF LONGINT);
  42.  
  43. VAR
  44.   min,x,y:LONGINT;
  45.   size:LONGINT;
  46.  
  47. BEGIN
  48.  
  49.   size:=LEN(values)-1;
  50.  
  51.   min:=0;
  52.  
  53.   FOR x:=1 TO size DO
  54.     IF values[x]<values[min] THEN
  55.       min:=x;
  56.     END;
  57.   END;
  58.   SwapLong(values[min],values[0]);
  59.  
  60.   FOR y:=1 TO size-1 DO
  61.     min:=y;
  62.     FOR x:=y+1 TO size DO
  63.       IF values[x]<=values[min] THEN
  64.         min:=x;
  65.         IF values[min]=values[y-1] THEN x:=size END;
  66.       END;
  67.     END;
  68.     SwapLong(values[y],values[min]);
  69.   END;
  70.  
  71. END SelectSortL;
  72.  
  73.  
  74. PROCEDURE SelectSortInt*(VAR values:ARRAY OF INTEGER);
  75.  
  76. VAR
  77.   min,x,y:LONGINT;
  78.   size:LONGINT;
  79.  
  80. BEGIN
  81.  
  82.   size:=LEN(values)-1;
  83.  
  84.   min:=0;
  85.  
  86.   FOR x:=1 TO size DO
  87.     IF values[x]<values[min] THEN
  88.       min:=x;
  89.     END;
  90.   END;
  91.   SwapInt(values[min],values[0]);
  92.  
  93.   FOR y:=1 TO size-1 DO
  94.     min:=y;
  95.     FOR x:=y+1 TO size DO
  96.       IF values[x]<=values[min] THEN
  97.         min:=x;
  98.         IF values[min]=values[y-1] THEN x:=size END;
  99.       END;
  100.     END;
  101.     SwapInt(values[y],values[min]);
  102.   END;
  103.  
  104. END SelectSortInt;
  105.  
  106.  
  107. PROCEDURE BubbleSortL*(VAR values:ARRAY OF LONGINT);
  108.  
  109. VAR
  110.   t,l:LONGINT;
  111.   slut:BOOLEAN;
  112.  
  113. BEGIN
  114.  
  115.   l:=LEN(values);
  116.   slut:=TRUE;;
  117.  
  118.   REPEAT
  119.     FOR t:=1 TO l-1 DO
  120.       IF values[t-1]>values[t] THEN
  121.         SwapLong(values[t-1],values[t]);
  122.         slut:=FALSE;
  123.       END;
  124.     END;
  125.     DEC(l);
  126.     IF l=0 THEN
  127.       slut:=TRUE;
  128.     END;
  129.   UNTIL slut;
  130.  
  131. END BubbleSortL;
  132.  
  133.  
  134. PROCEDURE BubbleSortInt*(VAR values:ARRAY OF INTEGER);
  135.  
  136. VAR
  137.   t,l:LONGINT;
  138.   slut:BOOLEAN;
  139.  
  140. BEGIN
  141.  
  142.   l:=LEN(values);
  143.   slut:=TRUE;;
  144.  
  145.   REPEAT
  146.     FOR t:=1 TO l-1 DO
  147.       IF values[t-1]>values[t] THEN
  148.         SwapInt(values[t-1],values[t]);
  149.         slut:=FALSE;
  150.       END;
  151.     END;
  152.     DEC(l);
  153.     IF l=0 THEN
  154.       slut:=TRUE;
  155.     END;
  156.   UNTIL slut;
  157.  
  158. END BubbleSortInt;
  159.  
  160.  
  161.  
  162. PROCEDURE QSortInt*(l,r:INTEGER; VAR values:ARRAY OF INTEGER);
  163.  
  164. VAR
  165.   i,j,x,y:INTEGER;
  166.  
  167. BEGIN
  168.   i:=l;
  169.   j:=r;
  170.   x:=values[(l+r) DIV 2];
  171.   REPEAT
  172.     WHILE values[i]<x DO
  173.       INC(i);
  174.     END;
  175.     WHILE x<values[j] DO
  176.       DEC(j);
  177.     END;
  178.     IF i<=j THEN
  179.       y:=values[i]; values[i]:=values[j]; values[j]:=y;
  180.       INC(i); DEC(j);
  181.     END;
  182.   UNTIL i>j;
  183.   IF l<j THEN QSortInt(l,j,values) END;
  184.   IF i<r THEN QSortInt(i,r,values) END;
  185.  
  186. END QSortInt;
  187.  
  188.  
  189. PROCEDURE QSortL*(l,r:LONGINT; VAR values:ARRAY OF LONGINT);
  190.  
  191. VAR
  192.   i,j,x,y:LONGINT;
  193.  
  194. BEGIN
  195.   i:=l;
  196.   j:=r;
  197.   x:=values[(l+r) DIV 2];
  198.   REPEAT
  199.     WHILE values[i]<x DO
  200.       INC(i);
  201.     END;
  202.     WHILE x<values[j] DO
  203.       DEC(j);
  204.     END;
  205.     IF i<=j THEN
  206.       y:=values[i]; values[i]:=values[j]; values[j]:=y;
  207.       INC(i); DEC(j);
  208.     END;
  209.   UNTIL i>j;
  210.   IF l<j THEN QSortL(l,j,values) END;
  211.   IF i<r THEN QSortL(i,r,values) END;
  212.  
  213. END QSortL;
  214.  
  215.  
  216. END SortTools.
  217.